VERSION 5.00Begin VB.Form Form1 BorderStyle = 1 'Fixed Single Caption = "Form1" ClientHeight = 6060 ClientLeft = 45 ClientTop = 435 ClientWidth = 9075 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False MousePointer = 1 'Arrow ScaleHeight = 6060 ScaleMode = 0 'User ScaleWidth = 9075 StartUpPosition = 3 '窗口缺省 Begin VB.ListBox List1 Height = 5820 ItemData = "Form1.frx":0000 Left = 2760 List = "Form1.frx":0002 TabIndex = 11 Top = 120 Width = 6255 End Begin VB.Frame Frame3 Caption = "RWStart area" Height = 1815 Left = 120 TabIndex = 8 Top = 4080 Width = 2535 Begin VB.CommandButton Command2 Caption = "结束" Height = 495 Left = 360 TabIndex = 10 Top = 1200 Width = 1335 End Begin VB.CommandButton Command1 Caption = "开启" Height = 495 Left = 360 TabIndex = 9 Top = 240 Width = 1335 End End Begin VB.Frame Frame2 Caption = "Data receive area" Height = 1935 Left = 120 TabIndex = 5 Top = 2160 Width = 2535 Begin VB.TextBox Text4 Height = 375 Left = 1440 TabIndex = 7 Top = 720 Width = 975 End Begin VB.TextBox Text3 Height = 375 Left = 1440 TabIndex = 6 Top = 240 Width = 975 End Begin VB.Label Label4 Caption = "接收高字节：" Height = 255 Left = 120 TabIndex = 13 Top = 720 Width = 1215 End Begin VB.Label Label3 Caption = "接收低字节：" Height = 255 Left = 120 TabIndex = 12 Top = 360 Width = 1215 End End Begin VB.Frame Frame1 Caption = "Data send area" Height = 1935 Left = 120 TabIndex = 0 Top = 120 Width = 2535 Begin VB.TextBox Text2 Height = 375 Left = 1440 TabIndex = 2 Top = 720 Width = 975 End Begin VB.TextBox Text1 Height = 375 Left = 1440 TabIndex = 1 Top = 240 Width = 975 End Begin VB.Label Label2 Caption = "发送高字节：" Height = 255 Left = 120 TabIndex = 4 Top = 720 Width = 1095 End Begin VB.Label Label1 Caption = "发送低字节：" Height = 255 Left = 120 TabIndex = 3 Top = 360 Width = 1095 End EndEndAttribute VB_Name = "Form1"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalseOption Explicit '程序中所有变量必须全部声明，否则编译出错Dim bAlertable As LongDim Capabilities As HIDP_CAPSDim DataString As StringDim DetailData As LongDim DetailDataBuffer() As ByteDim DeviceAttributes As HIDD_ATTRIBUTESDim DevicePathName As StringDim DeviceInfoSet As LongDim ErrorString As StringDim EventObject As LongDim HIDHandle As LongDim HIDOverlapped As OVERLAPPEDDim LastDevice As BooleanDim MyDeviceDetected As BooleanDim MyDeviceInfoData As SP_DEVINFO_DATADim MyDeviceInterfaceDetailData As SP_DEVICE_INTERFACE_DETAIL_DATADim MyDeviceInterfaceData As SP_DEVICE_INTERFACE_DATADim Needed As LongDim OutputReportData(7) As ByteDim PreparsedData As LongDim ReadHandle As LongDim Result As LongDim Security As SECURITY_ATTRIBUTESDim Timeout As BooleanDim Buffer() As Byte '转换字符串的缓冲区Dim RWflage As Boolean'这是厂商ID以及产品ID定义'16进制定义Const MyVendorID = &H925Const MyProductID = &H1299'系统初始化Private Sub Form_Load()Text1.Text = ""Text2.Text = ""Text3.Text = ""Text4.Text = ""MyDeviceDetected = FalseEnd Sub'数据转换与发送Private Sub Command1_Click()RWflage = FalseIf Text1.Text = "" Or Text2.Text = "" Then MsgBox "数据输入不能为空" Else If (Len(Text1.Text) > 2) Or (Len(Text1.Text) > 2) Then MsgBox "输入数据范围超出" Else Call StrringToHex '字符串转换为16进制数进行发送 End IfEnd IfIf RWflage = True ThenCall StartRW '调用函数进行数据发送与接收RWflage = FalseEnd IfEnd Sub'字符串到16进制数转换函数Private Sub StrringToHex() Dim Stri(4) As String Dim Store(4) As Byte Dim Flageerror1 As Boolean Dim Flageerror2 As Boolean Dim Flageerror3 As Boolean Dim Flageerror4 As Boolean Flageerror1 = True Flageerror2 = True Flageerror3 = True Flageerror4 = True 's首先转换低位数 Stri(0) = Mid$(Text1.Text, 1, 1) If (Stri(0) >= "0") And (Stri(0) <= "9") Then Store(0) = Asc(Stri(0)) - Asc("0") Else If (Stri(0) >= "A") And (Stri(0) <= "F") Then Store(0) = Asc(Stri(0)) - Asc("A") 10 Else If (Stri(0) >= "a") And (Stri(0) <= "f") Then Store(0) = Asc(Stri(0)) - Asc("a") 10 Else Flageerror1 = False MsgBox "输入数据有错，不再范围内" End If End If End If Stri(1) = Mid$(Text1.Text, 2, 1) If (Stri(1) >= "0") And (Stri(1) <= "9") Then Store(1) = Asc(Stri(1)) - Asc("0") Else If (Stri(1) >= "A") And (Stri(1) <= "F") Then Store(1) = Asc(Stri(1)) - Asc("A") 10 Else If (Stri(1) >= "a") And (Stri(1) <= "f") Then Store(1) = Asc(Stri(1)) - Asc("a") 10 Else Flageerror2 = False MsgBox "输入数据有错，不再范围内" End If End If End If Stri(2) = Mid$(Text2.Text, 1, 1) If (Stri(2) >= "0") And (Stri(2) <= "9") Then Store(2) = Asc(Stri(2)) - Asc("0") Else If (Stri(2) >= "A") And (Stri(2) <= "F") Then Store(2) = Asc(Stri(2)) - Asc("A") 10 Else If (Stri(2) >= "a") And (Stri(2) <= "f") Then Store(2) = Asc(Stri(2)) - Asc("a") 10 Else Flageerror3 = False MsgBox "输入数据有错，不再范围内" End If End If End If Stri(3) = Mid$(Text2.Text, 2, 1) If (Stri(3) >= "0") And (Stri(3) <= "9") Then Store(3) = Asc(Stri(3)) - Asc("0") Else If (Stri(3) >= "A") And (Stri(3) <= "F") Then Store(3) = Asc(Stri(3)) - Asc("A") 10 Else If (Stri(3) >= "a") And (Stri(3) <= "f") Then Store(3) = Asc(Stri(3)) - Asc("a") 10 Else Flageerror4 = False MsgBox "输入数据有错，不再范围内" End If End If End If If (Flageerror1 = True) And (Flageerror1 = True) And (Flageerror1 = True) And (Flageerror1 = True) Then RWflage = True OutputReportData(0) = (Store(0) * 16 Store(1)) OutputReportData(1) = (Store(2) * 16 Store(3))End IfEnd SubPrivate Sub StartRW()Dim count As Integer List1.AddItem "" List1.AddItem "***** HID Test Report *****" List1.AddItem " " & Format(Now, "general date") If MyDeviceDetected = False Then MyDeviceDetected = FindtheHidEnd IfIf MyDeviceDetected = True Then '如果设备找到了，准备数据进行发送 'OutputReportData(0) = Val(Text1.Text) 'OutputReportData(1) = Val(Text2.Text) Call WriteReport Call ReadReport End IfList1.ListIndex = List1.ListCount - 1'清楚部分数据，最多显示300个列表If List1.ListCount > 300 Then For count = 1 To 100 List1.RemoveItem (count) Next countEnd IfEnd Sub'系统退出函数Private Sub Command2_Click()Dim a As Integer a = MsgBox("确定要退出?", 1 64 0) If a = 1 Then End End IfEnd Sub'查询HID函数Function FindtheHid() As Boolean Dim HidGuid As GUID Dim MemberIndex As Long Dim GUIDString As String Dim count As Integer LastDevice = False MyDeviceDetected = False Security.lpSecurityDescriptor = 0 Security.bInheritHandle = True Security.nLength = Len(Security)'*******************************************************'HidD_GetHidGuid'获得HID GUID'Returns: the GUID in HidGuid.'这个函数不从Result返回数值'******************************************************* Result = HidD_GetHidGuid(HidGuid) Call DisplayResultOfAPICall("GetHidGuid") GUIDString = Hex$(HidGuid.Data1) & "-" & _ Hex$(HidGuid.Data2) & "-" & _ Hex$(HidGuid.Data3) & "-" For count = 0 To 7 If HidGuid.Data4(count) >= &H10 Then GUIDString = GUIDString & Hex$(HidGuid.Data4(count)) Else GUIDString = GUIDString & "0" & Hex$(HidGuid.Data4(count)) End If Next count List1.AddItem " GUID is:" & GUIDString'*****************************************************'SetupDiGetClassDevs'返回值：是所有HID设备的借口的数组地址'需要参数：HidD_GetHidGuid函数返回的HidGuid'***************************************************** DeviceInfoSet = SetupDiGetClassDevs _ (HidGuid, _ vbNullString, _ 0, _ (DIGCF_PRESENT Or DIGCF_DEVICEINTERFACE)) Call DisplayResultOfAPICall("SetupDiClassDevs") DataString = GetDataString(DeviceInfoSet, 32) List1.AddItem DataString'*****************************************************'SetupDiEnumDeviceInterfaces识别HID接口'次函数每一次调用都必须传递一个数组索引值来指定一个接口，用于查询所需要的HID接口'DeviceInfoSet是SetupDiGetClassDevs函数的返回值'InterfaceClassGuid 是HidGuid'DeviceInterfaceData是要传回的结构，来识别HID的一个接口'***************************************************** MemberIndex = 0Do MyDeviceInterfaceData.cbSize = LenB(MyDeviceInterfaceData) Result = SetupDiEnumDeviceInterfaces _ (DeviceInfoSet, _ 0, _ HidGuid, _ MemberIndex, _ MyDeviceInterfaceData) If Result = 0 Then LastDevice = True '如果返回0则证明所有查询已经结束 If Result <> 0 Then List1.AddItem " DeviceInfoSet for device #" & CStr(MemberIndex) & ": " List1.AddItem " cbSize = " & CStr(MyDeviceInterfaceData.cbSize) List1.AddItem " InterfaceclassGuid =" & GUIDString List1.AddItem " Flage =" & Hex$(MyDeviceInterfaceData.Flags) '****************************************************************************** 'SetupDiGetDeviceInterfaceDetail取得设备的路径,这个函数需要调用两次才能传递成功 '返回值：SP_DEVICE_INTERFACE_DETAIL_DATA结构，包含设备的信息 '调用两次：第一次返回正确的DeviceInterfaceDetailDataSize（Needed） ' 第二次返回正确的结构体 '****************************************************************************** MyDeviceInfoData.cbSize = Len(MyDeviceInfoData) Result = SetupDiGetDeviceInterfaceDetail _ (DeviceInfoSet, _ MyDeviceInterfaceData, _ 0, _ 0, _ Needed, _ 0) DetailData = Needed Call DisplayResultOfAPICall("SetupDiGetDeviceInterfaceDetail") List1.AddItem " (OK to say too small)" List1.AddItem " Required buffer size for the data: " & Needed 'Store the structure's size. MyDeviceInterfaceDetailData.cbSize = _ Len(MyDeviceInterfaceDetailData) ReDim DetailDataBuffer(Needed) '分配给字节数组足够的内存来存储结构 '把cbSize存储在数组的前4个字节中 Call RtlMoveMemory _ (DetailDataBuffer(0), _ MyDeviceInterfaceDetailData, _ 4) 'Call SetupDiGetDeviceInterfaceDetail again. 'This time, pass the address of the first element of DetailDataBuffer 'and the returned required buffer size in DetailData. Result = SetupDiGetDeviceInterfaceDetail _ (DeviceInfoSet, _ MyDeviceInterfaceData, _ VarPtr(DetailDataBuffer(0)), _ DetailData, _ Needed, _ 0) Call DisplayResultOfAPICall(" Result of second call: ") List1.AddItem " MyDeviceInterfaceDetailData.cbSize: " & _ CStr(MyDeviceInterfaceDetailData.cbSize) 'Convert the byte array to a string. DevicePathName = CStr(DetailDataBuffer()) 'Convert to Unicode. DevicePathName = StrConv(DevicePathName, vbUnicode) 'Strip cbSize (4 bytes) from the beginning. DevicePathName = Right$(DevicePathName, Len(DevicePathName) - 4) List1.AddItem " Device pathname: " List1.AddItem " " & DevicePathName '******************************************************************* 'CreateFile取得设备的代号 '应用此函数获得设备的代号，以后使用设备的代号来与设备交换数据 '数据需求：SetupDiGetDeviceInterfaceDetail函数返回的设备路径 '******************************************************************* HIDHandle = CreateFile _ (DevicePathName, _ GENERIC_READ Or GENERIC_WRITE, _ (FILE_SHARE_READ Or FILE_SHARE_WRITE), _ Security, _ OPEN_EXISTING, _ 0&, _ 0) Call DisplayResultOfAPICall("CreateFile") List1.AddItem " Returned handle: " & Hex$(HIDHandle) & "h" '下面开始检测HID接口是否是我们需要的HID接口，通过判断厂商ID与产品ID来确定 '************************************************************************ 'HidD_GetAttributes 获得厂商ID以及产品ID '数据需求：HIDD_ATTRIBUTES结构的Size成员的大小 ' 产品的HIDHandle(在CreatFile中的返回值) '************************************************************************ DeviceAttributes.Size = LenB(DeviceAttributes) Result = HidD_GetAttributes _ (HIDHandle, _ DeviceAttributes) Call DisplayResultOfAPICall("HidD_GetAttributes") If Result <> 0 Then List1.AddItem " HIDD_ATTRIBUTES 结构文件读取无误 " Else List1.AddItem " HIDD_ATTRIBUTES 结构文件读取错误 " End If List1.AddItem " Structure size: " & DeviceAttributes.Size List1.AddItem " Vendor ID: " & Hex$(DeviceAttributes.VendorID) List1.AddItem " Product ID: " & Hex$(DeviceAttributes.ProductID) List1.AddItem " Version Number: " & Hex$(DeviceAttributes.VersionNumber) If (DeviceAttributes.VendorID = MyVendorID) And (DeviceAttributes.ProductID = MyProductID) Then List1.AddItem " My device detected" MyDeviceDetected = True Else MyDeviceDetected = False '如果不是我们要找的HID接口，关闭此接口的代号 Result = CloseHandle _ (HIDHandle) Call DisplayResultOfAPICall("CloseHandle") End If MemberIndex = MemberIndex 1 '查询下一个 End IfLoop Until (LastDevice = True) Or (MyDeviceDetected = True)'释放SetupDiGetClassDevs函数获得的所有连接设备结构数组Result = SetupDiDestroyDeviceInfoList _ (DeviceInfoSet) Call DisplayResultOfAPICall("DestroyDeviceInfoList") If MyDeviceDetected = True Then FindtheHid = True '函数返回值 '获得设备的信息 Call GetDeviceCapabilities'获得读的代号 ReadHandle = CreateFile _ (DevicePathName, _ (GENERIC_READ Or GENERIC_WRITE), _ (FILE_SHARE_READ Or FILE_SHARE_WRITE), _ Security, _ OPEN_EXISTING, _ FILE_FLAG_OVERLAPPED, _ 0) Call DisplayResultOfAPICall("CreateFile, ReadHandle") List1.AddItem " Returned handle: " & Hex$(ReadHandle) & "h" Else List1.AddItem " Device not found." FindtheHid = False '函数返回值End If End Function'取得设备的信息Private Sub GetDeviceCapabilities()'***************************************************************'HidD_GetPreparsedData' HidDeviceObject 是前面CREATFILE函数获得的设备代号' PreparsedData是函数返回值，使一个班汉数据的缓冲区的指针'***************************************************************Result = HidD_GetPreparsedData _ (HIDHandle, _ PreparsedData) '***************************************************************'HidP_GetCaps取得设备的能力'是获得设备的报表描述符的一些基本内容，比如Usage、UsagePage、报表长度以及按钮能力、数值能力等的数目'***************************************************************Result = HidP_GetCaps _ (PreparsedData, _ Capabilities) Call DisplayResultOfAPICall("HidP_GetCaps")List1.AddItem " Last error: " & ErrorStringList1.AddItem " Usage: " & Hex$(Capabilities.Usage)List1.AddItem " Usage Page: " & Hex$(Capabilities.UsagePage)List1.AddItem " Input Report Byte Length: " & Capabilities.InputReportByteLengthList1.AddItem " Output Report Byte Length: " & Capabilities.OutputReportByteLengthList1.AddItem " Feature Report Byte Length: " & Capabilities.FeatureReportByteLengthList1.AddItem " Number of Link Collection Nodes: " & Capabilities.NumberLinkCollectionNodesList1.AddItem " Number of Input Button Caps: " & Capabilities.NumberInputButtonCapsList1.AddItem " Number of Input Value Caps: " & Capabilities.NumberInputValueCapsList1.AddItem " Number of Input Data Indices: " & Capabilities.NumberInputDataIndicesList1.AddItem " Number of Output Button Caps: " & Capabilities.NumberOutputButtonCapsList1.AddItem " Number of Output Value Caps: " & Capabilities.NumberOutputValueCapsList1.AddItem " Number of Output Data Indices: " & Capabilities.NumberOutputDataIndicesList1.AddItem " Number of Feature Button Caps: " & Capabilities.NumberFeatureButtonCapsList1.AddItem " Number of Feature Value Caps: " & Capabilities.NumberFeatureValueCapsList1.AddItem " Number of Feature Data Indices: " & Capabilities.NumberFeatureDataIndices'*****************************************************************'HidP_GetValueCaps 取得设备的数值能力'此函数传回一个报表中关于每个数值的信息的结构数组的指针'NumberInputValueCaps属性是HidP_GetCaps函数返回结构中的Capabilities.NumberInputValueCaps属性'*****************************************************************Dim ValueCaps(1023) As ByteResult = HidP_GetValueCaps _ (HidP_Input, _ ValueCaps(0), _ Capabilities.NumberInputValueCaps, _ PreparsedData) Call DisplayResultOfAPICall("HidP_GetValueCaps")'释放获得的设备能力的缓冲区指针Result = HidD_FreePreparsedData _ (PreparsedData) Call DisplayResultOfAPICall("HidD_FreePreparsedData")End Sub'写数据到设备Private Sub WriteReport() Dim count As Integer Dim NumberOfBytesToSend As Long Dim NumberOfBytesWritten As Long Dim ReadBuffer() As Byte Dim SendBuffer() As Byte ReDim SendBuffer(Capabilities.OutputReportByteLength - 1) SendBuffer(0) = 0 '这是报表ID号 For count = 1 To Capabilities.OutputReportByteLength - 1 SendBuffer(count) = OutputReportData(count - 1) '发送数据到发送缓冲区 Next count NumberOfBytesWritten = 0 Result = WriteFile _ (HIDHandle, _ SendBuffer(0), _ CLng(Capabilities.OutputReportByteLength), _ NumberOfBytesWritten, _ 0)Call DisplayResultOfAPICall("WriteFile")List1.AddItem " OutputReportByteLength = " & Capabilities.OutputReportByteLengthList1.AddItem " NumberOfBytesWritten = " & NumberOfBytesWrittenList1.AddItem " Report ID: " & SendBuffer(0)List1.AddItem " Report Data:"'UBound函数返回数组的长度（返回值是long型数据）For count = 1 To UBound(SendBuffer) List1.AddItem " " & Hex$(SendBuffer(count))Next count End Sub'读取报表函数Private Sub ReadReport()Dim countDim NumberOfBytesRead As LongDim ReadBuffer() As ByteDim UBoundReadBuffer As IntegerDim ByteValue As StringReDim ReadBuffer(Capabilities.InputReportByteLength - 1)'把列表框滚动到最低部List1.ListIndex = List1.ListCount - 1'建立一个事件对象来指示ReadFile的完成If EventObject = 0 Then EventObject = CreateEvent _ (Security, _ True, _ True, _ "")End If Call DisplayResultOfAPICall("CreateEvent") HIDOverlapped.Offset = 0HIDOverlapped.OffsetHigh = 0HIDOverlapped.hEvent = EventObjectResult = ReadFile _ (ReadHandle, _ ReadBuffer(0), _ CLng(Capabilities.InputReportByteLength), _ NumberOfBytesRead, _ HIDOverlapped)Call DisplayResultOfAPICall("ReadFile")'等待数据取回完毕List1.AddItem "waiting for ReadFile"List1.ListIndex = List1.ListCount - 1'****************************************************************'WaitForSingleObject'函数返回值代表是在规定时间内传回数据还是时间溢出'****************************************************************Result = WaitForSingleObject _ (EventObject, _ 6000) '6000代表6000毫秒Select Case Result Case WAIT_OBJECT_0 '如果数据完成的话 List1.AddItem "ReadFile completed successfully." Case WAIT_TIMEOUT '如果超时接收数据 '释放设备代号句柄 Result = CancelIo _ (ReadHandle) Call DisplayResultOfAPICall("CancelIo") '产生的原因可能是由于设备移除，所以应该释放设备代号 CloseHandle (HIDHandle) Call DisplayResultOfAPICall("CloseHandle (HIDHandle)") CloseHandle (ReadHandle) Call DisplayResultOfAPICall("CloseHandle (ReadHandle)") MyDeviceDetected = False Case Else '其他情况下 List1.AddItem "Readfile undefined error" MyDeviceDetected = False End SelectList1.AddItem " Report ID: " & ReadBuffer(0)List1.AddItem " Report Data:"Text3.Text = ""Text4.Text = ""For count = 1 To UBound(ReadBuffer) 'Add a leading 0 to values 0 - Fh. If Len(Hex$(ReadBuffer(count))) < 2 Then ByteValue = "0" & Hex$(ReadBuffer(count)) Else ByteValue = Hex$(ReadBuffer(count)) End If List1.AddItem " " & ByteValue 'Display the received bytes in the text box.Next count If (ReadBuffer(1)) < 16 Then Text3.Text = "0" & Hex$(ReadBuffer(1)) Else Text3.Text = Hex$(ReadBuffer(1)) End If If (ReadBuffer(2)) < 16 Then Text4.Text = "0" & Hex$(ReadBuffer(2)) Else Text4.Text = Hex$(ReadBuffer(2)) End IfCall ResetEvent(EventObject)Call DisplayResultOfAPICall("ResetEvent")End Sub'添加头Private Sub DisplayResultOfAPICall(FunctionName As String)List1.AddItem ""List1.AddItem FunctionName & ":"List1.ListIndex = List1.ListCount - 1End Sub'获得字符串表述符Private Function GetDataString _ (Address As Long, _ Bytes As Long) _As StringDim Offset As IntegerDim Result$Dim ThisByte As ByteFor Offset = 0 To Bytes - 1 Call RtlMoveMemory(ByVal VarPtr(ThisByte), ByVal Address Offset, 1) If (ThisByte And &HF0) = 0 Then Result$ = Result$ & "0" End If Result$ = Result$ & Hex$(ThisByte)Next OffsetGetDataString = Result$End Function
评论